home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / mask12.arc / MASK.INC < prev    next >
Encoding:
Text File  |  1988-01-07  |  13.8 KB  |  296 lines
  1.  
  2. '************************ THE MASKINPUT SUB ROUTINE *********************
  3.  
  4. SUB MASKINPUT(row%,col%,FieldTextAttr%,mask$,DefaultVal$,ReturnVal$,ftype%,Exitkey%) STATIC
  5.           SHARED NormAttr%,SLColor%,StatRow%,SkColor%,FieldChar%,FGColor%,BGColor%
  6.           SHARED ReturnCurrentPOS%
  7.           COLOR FGColor%,BGColor% : Fieldlen% = LEN(mask$): blankmask$ = STRING$(Fieldlen%,FieldChar%)
  8.           origcol% = col% : col% = col% + INSTR(DefaultVal$,chr$(FieldChar%)) - 1: noi% = 0
  9.           mpos% = 0 :  num.of.maskpos% = 0: Exitkey% = 0
  10.  
  11. FOR i% = 1 TO LEN(mask$)
  12.           a$ = MID$(mask$,i%,1)
  13.       IF ASC(a$) = FieldChar% THEN
  14.               noi% = noi% + 1
  15.               FieldPos%(noi%) = origcol%-1 + i%
  16.               tempmask$ = tempmask$ + chr$(FieldChar%)
  17.           ELSE
  18.               mpos% = mpos% + 1
  19.               maskpos%(mpos%,0) = origcol%-1 + i%
  20.           maskpos%(mpos%,1) = ASC(a$)
  21.               tempmask$ = tempmask$ + a$
  22.           END IF
  23. NEXT i%
  24.  
  25. mask$ = tempmask$ : tempmask$ = ""
  26.  
  27. CALL XQPRINT(SPACE$(59),StatRow%,1,SLColor%,0)
  28. CALL GETKBD(insert%,capslock%,numlock%,scrolllock%)
  29. CALL XQPRINT(mask$,row%,origcol%,FieldTextAttr%,0)
  30.  
  31. IF DefaultVal$ = "" THEN
  32.           DefaultVal$ = mask$
  33. ELSE
  34.           DefaultVal$ = LEFT$(DefaultVal$,noi%)
  35.           FOR i% = 1 TO LEN(DefaultVal$)
  36.               CALL XqPrint(MID$(DefaultVal$,i%,1),row%,FieldPos%(i%),FieldTextAttr%,0)
  37.           NEXT i%
  38.           ReturnVal$ = DefaultVal$
  39. END IF
  40.           IF ReturnCurrentPOS% THEN
  41.               currentpos% = ReturnCurrentPOS% : ReturnCurrentPOS%=0
  42.           ELSE
  43.               IF len(ReturnVal$) = noi% THEN
  44.                   currentpos% = 1
  45.               ELSE
  46.                   currentpos% = len(ReturnVal$)+1
  47.                   ReturnVal$ = ReturnVal$ + " "
  48.               END IF
  49.           END IF
  50.               LOCATE ROW%,FieldPos%(currentpos%),1
  51.               oldReturnVal$ = ReturnVal$ : oldcurrentpos% = currentpos%
  52. GETKEYS:
  53.  
  54.               CALL GETCHAR(CH$) :IF stat% THEN CALL STATLINE("",stat%)
  55.           IF ASC(CH$) = 27 THEN COLOR 7,0,0 : CLS : END  'Remove this and define your own meaning
  56.               CALL GETKBD(insert%,capslock%,numlock%,scrolllock%)
  57.               IF LEN(ch$) = 2 THEN GOTO ExtendedKeys
  58.           ch% = ASC(ch$)
  59.               SELECT CASE ch%
  60.                   CASE 27     'ESCAPE
  61.                       EXIT SUB ' remove or define you own meaning for Escape
  62.                       Exitkey% = 27
  63.                   CASE 9      'TAB KEY  a forward movement enter key
  64.                       Exitkey% = 15 : GOTO EXITROUTINE
  65.                   CASE 13     'ENTER
  66.                       EXITROUTINE:
  67.                       pf$ = ""
  68.                       FOR i% = origcol% to (origcol%+Fieldlen%-1)
  69.                        a% = screen(row%,i%)
  70.                        pf$ = pf$+chr$(a%)
  71.                       NEXT i%
  72.                       call xqprint(pf$+space$(Fieldlen%-len(pf$)),row%,origcol%,NormAttr%,0)
  73.                       IF Exitkey% = 0 THEN Exitkey% = 13
  74.                       EXIT SUB
  75.                   CASE 8          'BACKSPACE
  76.                       oldReturnVal$ = ReturnVal$ : oldcurrentpos% = currentpos%
  77.                       IF currentpos% = 1 THEN GOTO GETKEYS
  78.                       LastKey% = -1
  79.                       IF insert% THEN
  80.                        ReturnVal$ = left$(ReturnVal$,currentpos%-2) + right$(ReturnVal$, LEN(ReturnVal$) - (currentpos%-1))
  81.                        FOR i% = currentpos%-1 TO LEN(ReturnVal$)
  82.                         IF i% = 0 THEN GOTO BOL2        'Check for 0 value
  83.                         call xqprint(mid$(ReturnVal$,i%,1),row%,fieldpos%(i%),FieldTextAttr%,0)
  84.                         BOL2:
  85.                        NEXT i%
  86.                        IF LEN(ReturnVal$) = noi% THEN
  87.                         call xqprint(chr$(FieldChar%),row%,fieldpos%(len(ReturnVal$)),FieldTextAttr%,0)
  88.                        ELSE
  89.                         call xqprint(chr$(FieldChar%),row%,fieldpos%(len(ReturnVal$)+1),FieldTextAttr%,0)
  90.                        END IF
  91.                        BOL3:
  92.                       ELSE
  93.                        ReturnVal$ = left$(ReturnVal$,currentpos%-2) + chr$(FieldChar%) + right$(ReturnVal$, LEN(ReturnVal$) - (currentpos%-1))
  94.                        call xqprint(chr$(FieldChar%),row%,fieldpos%(currentpos%-1),FieldTextAttr%,0)
  95.                       END IF
  96.                       GOSUB CHECKPOS
  97.                       LOCATE ,FieldPos%(currentpos%),1
  98.                       GOTO GETKEYS
  99.                   CASE ELSE
  100.                       IF ftype% = -1 THEN  'IF numeric only
  101.                IF ASC(ch$) < 48 OR ASC(Ch$) > 57 THEN
  102.                         statmssg$ = "Input must be NUMBERS ONLY"
  103.                         CALL statline(statmssg$,stat%)
  104.                         GOTO GETKEYS
  105.                        END IF
  106.                       ELSE
  107.                IF ASC(ch$) < 32  OR ASC(Ch$) > 127 THEN GOTO GETKEYS
  108.                       END IF
  109.                       LastKey% = 1: GOTO INSCH
  110.               END SELECT
  111.  
  112. INSCH:          'VERIFY LEN OF FIELD & INSERT KEY MODE & PRINT CHARACTER
  113.           IF insert% AND LEN(ReturnVal$) = NOI% THEN
  114.              oldReturnVal$ = ReturnVal$ : oldcurrentpos% = currentpos%
  115.                IF RIGHT$(ReturnVal$,1) = chr$(FieldChar%) THEN
  116.                   ReturnVal$ = left$(ReturnVal$,noi%-1)
  117.                ELSE
  118.                   statmssg$ = "Input Field Is Full"
  119.                   CALL statline(statmssg$,stat%)
  120.                   CALL CLRKBD
  121.                   GOTO GETKEYS
  122.                END IF
  123.           END IF
  124.           CALL XqPrint(ch$,row%,FieldPos%(currentpos%),FieldTextAttr%,0)
  125.           IF insert% THEN
  126.               oldReturnVal$ = ReturnVal$ : oldcurrentpos% = currentpos%
  127.               ReturnVal$ = left$(ReturnVal$,currentpos%-1) + ch$ + right$(ReturnVal$, LEN(ReturnVal$) - (currentpos%-1))
  128.               FOR i% = currentpos%+1 TO LEN(ReturnVal$)
  129.                   CALL XqPrint(MID$(ReturnVal$,i%,1),row%,FieldPos%(i%),FieldTextAttr%,0)
  130.               NEXT i%
  131.           ELSE
  132.               oldReturnVal$ = ReturnVal$ : oldcurrentpos% = currentpos%
  133.               new1$ = left$(ReturnVal$,currentpos%-1) + ch$
  134.               IF len(ReturnVal$) > len(new1$) THEN
  135.                   new2$ = right$(ReturnVal$, LEN(ReturnVal$) - (currentpos%))
  136.               ELSE
  137.                   new2$ = ""
  138.               END IF
  139.               ReturnVal$ = new1$ + new2$
  140.           END IF
  141.           currentpos% = currentpos% + (LastKey%)
  142.           IF currentpos% > noi% THEN currentpos% = noi%
  143.           LOCATE ,FieldPos%(currentpos%),1
  144.           GOTO GETKEYS
  145.  
  146. ExtendedKeys:                   'GET EXTENDED KEYS.  ADD OR CHANGE AS YOU NEED
  147.       extkey = ASC(RIGHT$(ch$,1))
  148.           SELECT CASE extkey
  149.               CASE 15     'SHIFT TAB a backward movement exit key or just a exit key
  150.                   Exitkey% = 15 : GOTO EXITROUTINE
  151.  
  152.               CASE 22             'Alt-U   UNDO last command
  153.                   IF ReturnVal$ = oldReturnVal$ THEN goto getkeys
  154.                   tempReturnVal$ = ReturnVal$ : tempcurrentpos% = currentpos%
  155.                   call XqPrint(mask$,row%,origcol%,FieldTextAttr%,0)
  156.                   IF noi% = LEN(mask$) THEN
  157.                       call XqPrint(oldReturnVal$,row%,origcol%,FieldTextAttr%,0)
  158.                       goto bottomofaltu
  159.                   END IF
  160.                   FOR i% = 1 TO LEN(oldReturnVal$)
  161.                       CALL XqPrint(MID$(oldReturnVal$,i%,1),row%,FieldPos%(i%),FieldTextAttr%,0)
  162.                   NEXT i%
  163.                   bottomofaltu:
  164.                   ReturnVal$ = oldReturnVal$ : currentpos% = oldcurrentpos%
  165.                   oldReturnVal$ = tempReturnVal$ : oldcurrentpos% = tempcurrentpos%
  166.                   locate ,fieldpos%(currentpos%),1:  goto getkeys
  167.  
  168.               CASE 59                 'F1 REDEFINE FOR YOUR OWN USE
  169.                   IF sh% THEN COLOR FGColor%,BGColor%,BGColor%
  170.                   REM $INCLUDE : 'MASK.HLP'       'HELP FILE FOR DEMO ONLY
  171.                   'ReturnCurrentPOS% = Currentpos% 'This is how you return the
  172.                                'user back to exact cursor location.
  173.  
  174.               CASE 72     'CURSOR UP      a backward exit key
  175.                   Exitkey% = 72  : GOTO EXITROUTINE
  176.  
  177.               CASE 80     'CURSOR DOWN    a forward exit key
  178.                   Exitkey% = 80  : GOTO EXITROUTINE
  179.  
  180.               CASE 117            'Ctrl-End Delete to end of line
  181.                   oldReturnVal$ = ReturnVal$ : oldcurrentpos% = currentpos%
  182.                   ReturnVal$ = left$(ReturnVal$,currentpos%-1)+ " "
  183.                   IF mpos% = 0 THEN
  184.                       call XqPrint(space$(origcol%+LEN(mask$)-POS(0)),row%,pos(0),FieldTextAttr%,0)
  185.                       GOTO getkeys
  186.                   END IF
  187.                   call XqPrint(space$(origcol%+LEN(mask$)-POS(0)),row%,pos(0),FieldTextAttr%,0)
  188.                   FOR i% = 1 TO mpos%
  189.                       call XqPrint(chr$(maskpos%(i%,1)),row%,maskpos%(i%,0),FieldTextAttr%,0)
  190.                   NEXT i%
  191.                   GOTO getkeys
  192.  
  193.               CASE 75             'CURSOR-LEFT
  194.                   LastKey% = -1 : GOSUB CHECKPOS: LOCATE ,FieldPos%(currentpos%),1
  195.                   GOTO GETKEYS
  196.  
  197.               CASE 77         'CURSOR-RIGHT
  198.                   IF currentpos% < LEN(ReturnVal$) THEN
  199.                       LastKey% = 1 : GOSUB CHECKPOS: LOCATE ,FieldPos%(currentpos%),1
  200.                       GOTO GETKEYS
  201.                   ELSE
  202.                       IF RIGHT$(ReturnVal$,1) <> " " AND LEN(ReturnVal$) < noi% THEN
  203.                        ReturnVal$=ReturnVal$+" " : LastKey% = 1
  204.                        GOSUB CHECKPOS: LOCATE ,FieldPos%(currentpos%),1
  205.                        GOTO GETKEYS
  206.                       END IF
  207.                       statmssg$ = "To move past your input use the SPACE BAR"
  208.                       CALL statline(statmssg$,stat%)
  209.                       GOTO GETKEYS
  210.                   END IF
  211.  
  212.               CASE 71         'HOME KEY
  213.                   LOCATE ,fieldpos%(1) : currentpos% = 1 : goto getkeys
  214.  
  215.               CASE 79         'END KEY
  216.                   FOR char% = LEN(ReturnVal$) TO 1 STEP -1
  217.                       word$ = MID$(ReturnVal$, char%, 1)
  218.                       IF word$ <> chr$(FieldChar%) THEN
  219.                        EXIT FOR
  220.                       END IF
  221.                   NEXT char%
  222.                   IF MID$(ReturnVal$,char%+1,1) = chr$(FieldChar%) THEN
  223.                       char% = char% + 1 : GOTO BOEND
  224.                   END IF
  225.                   IF char% = LEN(ReturnVal$) AND char% <> noi% THEN
  226.                      ReturnVal$ = ReturnVal$ + chr$(FieldChar%)
  227.                      char% = LEN(ReturnVal$)
  228.                   END IF
  229.                   BOEND:
  230.                   currentpos% = char%
  231.                   LastKey% = 0
  232.                   LOCATE ,fieldpos%(currentpos%) : goto getkeys
  233.  
  234.               CASE 83                     '**** DELETE KEY ****
  235.                   oldReturnVal$ = ReturnVal$ : oldcurrentpos% = currentpos%
  236.                   IF LEN(ReturnVal$) = 0 THEN GOTO GETKEYS
  237.                   IF currentpos% > LEN(ReturnVal$) THEN GOTO GETKEYS
  238.                   IF currentpos% > 1 THEN
  239.                       ReturnVal$ = left$(ReturnVal$,currentpos%-1) + right$(ReturnVal$, LEN(ReturnVal$) - (currentpos%))
  240.                   ELSE
  241.                       ReturnVal$ = RIGHT$(ReturnVal$,len(ReturnVal$)-1)
  242.                   END IF
  243.                   LastKey% = 0
  244.                   call xqprint(chr$(FieldChar%),row%,fieldpos%(len(ReturnVal$)+1),FieldTextAttr%,0)
  245.                   FOR i% = currentpos% TO LEN(ReturnVal$)
  246.                       call xqprint(mid$(ReturnVal$,i%,1),row%,fieldpos%(i%),FieldTextAttr%,0)
  247.                   NEXT i%
  248.                   GOSUB CHECKPOS : LOCATE ,FieldPos%(currentpos%),1 : GOTO GETKEYS
  249.  
  250.               CASE 116            'Ctrl-Right Arrow - Next Word
  251.                   LastKey% = 0
  252.                   wordloc% = INSTR(currentpos%+1,ReturnVal$," ")
  253.                   IF wordloc% >= LEN(ReturnVal$) OR wordloc% = 0 THEN GOTO GETKEYS
  254.                   FOR char% = wordloc% TO LEN(ReturnVal$)
  255.                       word$ = MID$(ReturnVal$, char%, 1)
  256.                       IF word$ <> " " THEN
  257.                        wordloc% = char%
  258.                        EXIT FOR
  259.                       END IF
  260.                   NEXT char%
  261.                   IF wordloc% > 1 AND wordloc% > currentpos%+1 THEN currentpos% = wordloc%
  262.                   GOSUB CHECKPOS : LOCATE ,FieldPos%(currentpos%),1 : GOTO GETKEYS
  263.  
  264.               CASE 115             'Ctrl-left Arrow - Next Word
  265.                   CTAGAIN:
  266.                   FOR char% = currentpos% TO 1 STEP -1
  267.                       word$ = MID$(ReturnVal$, char%, 1)
  268.                       IF word$ = " " AND char% < currentpos% THEN
  269.                        EXIT FOR
  270.                       END IF
  271.                   NEXT char%
  272.                   IF currentpos% - char% = 1 THEN
  273.                       currentpos% = currentpos% - 1
  274.                       GOTO CTAGAIN
  275.                   END IF
  276.                   currentpos% = char%+1
  277.                   LastKey% = 0
  278.                   GOSUB CHECKPOS : LOCATE ,FieldPos%(currentpos%),1 : GOTO GETKEYS
  279.  
  280.               CASE 48                     'ALT-B  Blank Field
  281.                   oldReturnVal$ = ReturnVal$ : oldcurrentpos% = currentpos%
  282.                   locate ,,0 : ReturnVal$ = mask$
  283.                   CALL XqPRINT(mask$,row%,origcol%,FieldTextAttr%,0) :ReturnVal$ = ""
  284.                   currentpos% = 1 :locate ,fieldpos%(1),1:  goto getkeys
  285.               CASE ELSE
  286.                   GOTO GETKEYS        ' GO GET ANOTHER KEY FROM USER
  287.           END SELECT
  288.  
  289. Checkpos:               'CHECK THE CURSOR POSITION BEING REQUESTED AND RETURN
  290.           currentpos% = currentpos% + (LastKey%)
  291.           IF currentpos% < 1 THEN currentpos% = 1
  292.           IF currentpos% > noi% THEN currentpos% = noi%
  293. RETURN
  294. END SUB
  295.  
  296.